home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / generic / utils.lisp < prev    next >
Encoding:
Text File  |  1992-05-19  |  2.5 KB  |  75 lines
  1. ;;; -*- Package: VM; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: utils.lisp,v 1.3 92/03/12 15:25:02 wlott Locked $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: utils.lisp,v 1.3 92/03/12 15:25:02 wlott Locked $
  15. ;;;
  16. ;;; Utility functions needed by the back end to generate code.
  17. ;;;
  18. ;;; Written by William Lott.
  19. ;;; 
  20.  
  21. (in-package "VM")
  22.  
  23. (export '(fixnum static-symbol-p static-symbol-offset offset-static-symbol
  24.          static-function-offset))
  25.  
  26.  
  27.  
  28. ;;;; Handy routine for making fixnums:
  29.  
  30. (defun fixnum (num)
  31.   "Make a fixnum out of NUM.  (i.e. shift by two bits if it will fit.)"
  32.   (if (<= #x-20000000 num #x1fffffff)
  33.       (ash num 2)
  34.       (error "~D is too big for a fixnum." num)))
  35.  
  36.  
  37.  
  38. ;;;; Routines for dealing with static symbols.
  39.  
  40. (defun static-symbol-p (symbol)
  41.   (member symbol static-symbols))
  42.  
  43. (defun static-symbol-offset (symbol)
  44.   "Returns the byte offset of the static symbol Symbol."
  45.   (let ((posn (position symbol static-symbols)))
  46.     (unless posn (error "~S is not a static symbol." symbol))
  47.     (+ (* posn (pad-data-block symbol-size))
  48.        (pad-data-block (1- symbol-size))
  49.        other-pointer-type
  50.        (- list-pointer-type))))
  51.  
  52. (defun offset-static-symbol (offset)
  53.   "Given a byte offset, Offset, returns the appropriate static symbol."
  54.   (multiple-value-bind
  55.       (n rem)
  56.       (truncate (+ offset list-pointer-type (- other-pointer-type)
  57.            (- (pad-data-block (1- symbol-size))))
  58.         (pad-data-block symbol-size))
  59.     (unless (and (zerop rem) (<= 0 n (1- (length static-symbols))))
  60.       (error "Byte offset, ~D, is not correct." offset))
  61.     (elt static-symbols n)))
  62.  
  63. (defun static-function-offset (name)
  64.   "Return the (byte) offset from NIL to the start of the fdefn object
  65.    for the static function NAME."
  66.   (let ((static-syms (length static-symbols))
  67.     (static-function-index (position name static-functions)))
  68.     (unless static-function-index
  69.       (error "~S isn't a static function." name))
  70.     (+ (* static-syms (pad-data-block symbol-size))
  71.        (pad-data-block (1- symbol-size))
  72.        (- list-pointer-type)
  73.        (* static-function-index (pad-data-block fdefn-size))
  74.        (* fdefn-raw-addr-slot word-bytes))))
  75.